home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #34 (1994-08)(Diesel)(DE)[WB].zip / Purity #34 (1994-08)(Diesel)(DE)[WB].adf / DiskLabel / DiskLabel1.03.p < prev    next >
Text File  |  1994-08-06  |  22KB  |  648 lines
  1. { DiskLabel: schnelles und nettes Bedrucken von 3.5" 70x69 Disketten-
  2.              etiketten. (fontsensitiv...)
  3.  
  4.   Das Programm ist FREEWARE.
  5.  
  6.   Es müssen folgenden Datein, inkl. deren Icons enthalten sein:
  7.  
  8.   DiskLabel, DiskLabel.dok, DiskLabel.p (nur Purity)
  9.  
  10.   Erstellt mit KickPascal 2.12 / OS2-Includes von Maxon Computer GmbH
  11.  
  12.   Programmierer:    Falk Zühlsdorff (PackMAN)
  13.                     Lindenberg 66
  14.                     98693 Ilmenau / Thüringen                          }
  15.  
  16. PROGRAM dl;
  17.  
  18. USES REQTOOLS4,GADTOOLS,BATTCLOCKLIGHT,PrtChk;
  19. {$ incl "dos.lib"};
  20.  
  21. TYPE  Tagtype           = array[0..4] OF TagItem;
  22.       GTagtype          = array[0..11] OF TagType;
  23.       strtype           = string[300];
  24.       CTextType         = array[0..28] OF String[14];
  25.  
  26. VAR   PScr              : p_screen;          {PublicScreen}
  27.       Pubscrname        : string[10];STATIC;
  28.       drawinfo          : p_drawinfo;        {dessen Drawinfo}
  29.       txattr            : TextAttr;
  30.       font              : p_textfont;
  31.       ysize,ScrTextFont,
  32.       baseline,rem      : word;STATIC;
  33.       Wbr               : integer;STATIC;
  34.       ourfont,RT,mIDCMP : long;STATIC;
  35.       ALLOK,ex,help,
  36.       Vorab,StrAkt      : boolean;STATIC;
  37.       Win               : ^Window;
  38.       RP                : ^RastPort;
  39.  
  40.       msg               : ^IntuiMessage;
  41.       akt               : ^Gadget;
  42.  
  43.       NWTags            : array[1..12] OF tagitem;STATIC;
  44.       titel,fontname    : string;STATIC;
  45.  
  46.       pgad,glist        : p_Gadget;
  47.       vi                : PTR;
  48.       chNr1,chNr2,i,
  49.       cycleNr           : byte;STATIC;
  50.  
  51.       {****************}
  52.       ng                : NewGadget;STATIC;
  53.       g                 : array[0..15] OF p_Gadget;STATIC;
  54.       GTags             : array[0..2] OF TagItem;STATIC;
  55.       Tags              : GTagType;STATIC;
  56.       CyTx              : CTextType;STATIC;
  57.       CyLa              : array[0..28] of string[3];STATIC;
  58.       cfeld             : array[0..29] OF STR;              {@-Gad}
  59.       STx               : array[0..9] OF string[36];STATIC;
  60.  
  61.       sig               : ^stringinfo;
  62.  
  63.       Code              : Byte;
  64.       gedr1,gedr2       : boolean;
  65.  
  66. {-------------------------------------------------------------------------}
  67. PROCEDURE abschalten;
  68. BEGIN
  69.  mIDCMP:=Win^.IDCMPFlags;
  70.  help:=ModifyIDCMP(Win,0);
  71.  rem:=RemoveGList(Win,g[0],16);
  72. END;
  73. {-------------------------------------------------------------------------}
  74. PROCEDURE zuschalten;
  75. BEGIN
  76.  help:=ModifyIDCMP(Win,mIDCMP);
  77.  rem:=AddGList(Win,g[0],0,16,nil);
  78. END;
  79. {-------------------------------------------------------------------------}
  80. FUNCTION RTReq(Titel,Text,gadtx:string,Pos:byte):long;
  81. VAR tags        : array[0..7] of tagitem;STATIC;
  82. BEGIN
  83.    Tags[0]:=TagItem(RTEZ_Reqtitle,Long(^titel));
  84.    Tags[1]:=TagItem(RTGS_GadFmt,long(^gadtx));
  85.    Tags[2]:=TagItem(RT_UnderScore,long('_'));
  86.    Tags[3]:=TagItem(RTGS_BackFill,long(false));
  87.    Tags[4]:=TagItem(RT_ReqPos,Pos);
  88.    Tags[5]:=TagItem(RTGS_Flags,GSREQF_CENTERTEXT or GSREQF_HIGHLIGHTTEXT);
  89.    Tags[6]:=TagItem(RT_Window,long(Win));
  90.    Tags[7].ti_tag:=Tag_END;
  91.    RTReq:=rtEZRequestA(^Text,^gadtx,NIL,NIL,^Tags[0]);
  92. END;
  93. {-------------------------------------------------------------------------}
  94. FUNCTION RTReq2(Titel:string,Text:strtype,gadtx:string,Pos,left,
  95.                 top:long):long;
  96. VAR tags        : array[0..10] of tagitem;STATIC;
  97. BEGIN
  98.    Tags[0]:=TagItem(RTEZ_Reqtitle,Long(^titel));
  99.    Tags[1]:=TagItem(RTGS_GadFmt,long(^gadtx));
  100.    Tags[2]:=TagItem(RT_UnderScore,long('_'));
  101.    Tags[3]:=TagItem(RTGS_BackFill,long(false));
  102.    Tags[4]:=TagItem(RT_ReqPos,Pos);
  103.    Tags[5]:=TagItem(RT_LeftOffset,left);
  104.    Tags[6]:=TagItem(RT_TopOffset,top);
  105.    Tags[7]:=TagItem(RT_TextAttr,long(^txattr));
  106.    Tags[8]:=TagItem(RTGS_Flags,GSREQF_CENTERTEXT or GSREQF_HIGHLIGHTTEXT);
  107.    Tags[9]:=TagItem(RT_Window,long(Win));
  108.    Tags[10].ti_tag:=Tag_END;
  109.    RTReq2:=rtEZRequestA(^Text,^gadtx,NIL,NIL,^Tags[0]);
  110. END;
  111. {-------------------------------------------------------------------------}
  112. PROCEDURE Topaz8;
  113. BEGIN
  114.  fontname:='topaz.font';
  115.  ysize:=8;
  116.  WBr:=8;
  117.  txattr:=TextAttr(fontname,ysize,0,0);
  118.  Font:=OpenFont(^txattr);
  119. END;
  120. {-------------------------------------------------------------------------}
  121. PROCEDURE InfoLine;
  122. CONST up:=chr(10);
  123. BEGIN
  124.  abschalten;
  125.  RT:=RTReq2('Information',
  126.             'Etikettendruck (3.5"/ 70x69 mm)'+up+up+
  127.             'Erstellt in KickPascal 2.12/OS2'+up+up+
  128.             'FREEWARE'+up+up+
  129.             '© & P by PackMAN'+up+
  130.             'c/o Falk Zühlsdorff'+up+
  131.             'Lindenberg 66'+up+
  132.             'D-98693 Ilmenau / Thüringen'+up+up+
  133.             'Reqtools.library © by N.François',
  134.             '_OK',5,Win^.LeftEdge+Wbr+Round(Wbr/2),Win^.Topedge+3*ysize);
  135.  zuschalten;
  136. END;
  137. {-------------------------------------------------------------------------}
  138. PROCEDURE Neu;
  139. BEGIN
  140.  STx[0]:='';
  141.  STx[9]:='';
  142.  FOR i:=2 TO 7 DO STx[i]:='';
  143.  GT_SetGadgetAttrsA(g[0],Win,NIL,^Tags[0,3]);
  144.  FOR i:=2 TO 7 DO GT_SetGadgetAttrsA(g[i],Win,NIL,^Tags[i,3]);
  145.  GT_SetGadgetAttrsA(g[9],Win,NIL,^Tags[9,3]);
  146. END;
  147. {-------------------------------------------------------------------------}
  148. PROCEDURE GetStrGaddata;    {my fantastic methode}
  149. BEGIN
  150.   FOR i:=0 TO 9 DO
  151.    BEGIN
  152.     sig:=g[i]^.SpecialInfo;
  153.     STx[i]:=sig^.buffer;
  154.    END;
  155. END;
  156. {------------------------------------------------------------------------}
  157.  
  158. PROCEDURE Druck;
  159. CONST ESC:=CHR(27);
  160.       Test:='PRT:';
  161. VAR LST           : text;STATIC;
  162.     outfile       : BPTR;STATIC;
  163.     anzahl,abc,
  164.     RTPl,x,j      : long;STATIC;
  165.     strg          : String[2];STATIC;
  166.  
  167.  FUNCTION check:boolean;
  168.  VAR ok:byte;STATIC;
  169.  BEGIN
  170.    ok:=CheckPrt;
  171.    IF ok=0
  172.     THEN check:=true
  173.     ELSE
  174.      BEGIN
  175.       check:=false;
  176.       CASE ok OF
  177.        1: RT:=RTReq('DiskLabel',
  178.                     'Drucker: offline','_JA',Reqpos_TopleftScr);
  179.        2: RT:=RTReq('DiskLabel',
  180.                     'Drucker: kein Papier','_JA',Reqpos_TopleftScr);
  181.        3: RT:=RTReq('DiskLabel',
  182.                     'Drucker: offline/kein Papier','_JA',
  183.                     Reqpos_TopleftScr);
  184.  
  185.       ELSE;END;
  186.       zuschalten;
  187.      END;
  188.  END;
  189.  
  190. {---OF Druck----}
  191.  
  192. BEGIN
  193.  abschalten;
  194.  GetStrGaddata;
  195.  RTPl:=RTReq('DiskLabel',
  196.             'Drucken mit NLQ','_JA|_Nein',Reqpos_Pointer);
  197.  IF NOT Check THEN EXIT;
  198.  strg:=' ';
  199.  outfile:=Open(Test,Mode_OLDFILE);                {Drucker ansprechen}
  200.  IF outfile<>0 THEN
  201.    BEGIN
  202.     anzahl:=dosWrite(outfile,^strg,3); {Online okay ... Test2 for fucking }
  203.     IF anzahl=3 THEN                   {Printers,like mine C=1550C}
  204.      BEGIN
  205.       abc:=DOSClose(outfile);
  206.       Rewrite(LST,'PRT:');
  207.       IF IOResult=0
  208.        THEN
  209.         BEGIN
  210.          write(LST,ESC,'#1',ESC,'[1z',ESC,'[1p');            {init+1/6"}
  211.          IF RTPl=1 THEN write(LST,ESC,'[2"z')
  212.                    ELSE write(LST,ESC,'[1"z');
  213.          write(LST,ESC,'[4w',ESC,'[2v');                     {superscript}
  214.          IF (chNr2=1) AND (STx[9]<>'')
  215.           THEN
  216.            BEGIN
  217.             x:=34-strlen(STx[0]);
  218.             write(LST,STx[0]);
  219.             FOR i:=0 TO x DO write(LST,' ');                 {Kante}
  220.             writeln(LST,'Nr: ',STx[9]);
  221.            END
  222.           ELSE writeln(LST,STx[0]);
  223.  
  224.          writeln(LST,ESC,'[3w',ESC,'[1v',ESC,'[6w');
  225.          x:=TRUNC((13-strlen(STx[1]))/2);                     {Verwendung}
  226.          FOR i:=1 TO x DO write(LST,' ');
  227.          writeln(LST,STx[1]);
  228.          writeln(LST);
  229.          write(LST,ESC,'[5w',ESC,'[0w',ESC,'[1w');
  230.          FOR i:=2 TO 7 DO
  231.           BEGIN
  232.            IF STx[i]<>''
  233.             THEN
  234.              BEGIN
  235.               x:=TRUNC((25-strlen(STx[i]))/2);                {Zeile 1..6}
  236.               FOR j:=1 TO x DO write(LST,' ');
  237.               writeln(LST,STx[i]);
  238.              END
  239.             ELSE
  240.              writeln(LST);
  241.           END;
  242.          writeln(LST);
  243.          IF (chNr2=1) AND (STx[9]<>'')
  244.           THEN
  245.            BEGIN
  246.             IF chNr1=1
  247.              THEN
  248.               BEGIN
  249.                x:=17-strlen(STx[8]);                            {Date}
  250.                write(LST,STx[8]);
  251.                FOR i:=1 TO x DO write(LST,' ');
  252.               END
  253.              ELSE write(LST,'                 ');
  254.             writeln(LST,'Nr: ',STx[9]);                         {Nr}
  255.            END
  256.           ELSE
  257.            writeln(LST,STx[8]);
  258.          Close(LST);
  259.         END;
  260.      END;
  261.    END;
  262.  zuschalten;
  263. END;
  264. {-------------------------------------------------------------------------}
  265. PROCEDURE cycle(taste:byte);
  266. BEGIN
  267.  IF gedr1 OR gedr2
  268.   THEN
  269.    IF cycleNr=0  THEN cycleNr:=28
  270.                  ELSE DEC(cycleNr)
  271.   ELSE
  272.    IF cycleNr=28 THEN  cycleNr:=0
  273.                  ELSE INC(cycleNr);
  274.  IF taste=1 THEN
  275.   BEGIN
  276.    Tags[10]:=TagItem(GTCY_Active,cycleNr);
  277.    GT_SetGadgetAttrsA(g[13],Win,NIL,^Tags[10]);
  278.   END;
  279.  STx[1]:=CyTx[cycleNr];
  280.  GT_SetGadgetAttrsA(g[1],Win,NIL,^Tags[1,3]);
  281. END;
  282. {-------------------------------------------------------------------------}
  283. PROCEDURE Ende;
  284. BEGIN
  285.  abschalten;
  286.  RT:=RTReq('DiskLabel',
  287.             'Programm beenden ?','_JA|_Zurück',Reqpos_Pointer);
  288.  IF RT=1 THEN ex:=true;
  289.  zuschalten;
  290. END;
  291. {-------------------------------------------------------------------------}
  292. PROCEDURE InitWin;
  293. BEGIN
  294.  ALLOK:=false;
  295.  Vorab:=false;
  296.  PScr:=NIL;
  297.  pubscrname:='Workbench';
  298.  PScr:=lockpubscreen(pubscrname);
  299.  IF PScr<>NIL THEN
  300.   BEGIN
  301.    drawinfo:=getscreendrawinfo(PScr);
  302.     IF drawinfo<>NIL THEN
  303.      BEGIN
  304.       font:=drawinfo^.dri_font;
  305.       ysize:=font^.tf_ysize;
  306.       ScrTextFont:=ysize;
  307.       baseline:=font^.tf_baseline;
  308.       Wbr:=textlength(^PScr^.rastport,'W',1);
  309.       vi:=GetVisualinfoA(PScr,nil);
  310.       IF (Wbr*44>Pscr^.width) OR (25*ysize>Pscr^.height) THEN VORAB:=true;
  311.       freescreendrawinfo(PScr,drawinfo);
  312.       UnlockPubScreen(NIL,PScr);
  313.       Pgad:=NIL;
  314.       Pgad:=CreateContext(^Glist);
  315.       IF pgad<>nil
  316.        THEN
  317.         BEGIN
  318.          fontname:=drawinfo^.dri_font^.tf_Message.mn_Node.ln_Name;
  319.          txattr:=TextAttr(fontname,ysize,0,0);
  320.          IF Vorab THEN
  321.           BEGIN
  322.            RT:=RTReq('DiskLabel',
  323.                       'Ungünstiges Verhältnis'\10'Screenfont : Screengröße',
  324.                       '_Topaz 8|_Ende',ReqPos_TopLeftScr);   {4}
  325.            IF RT=1 THEN topaz8
  326.                    ELSE
  327.                     BEGIN
  328.                      FreeGadgets(glist);
  329.                      FreeVisualInfo(vi);
  330.                      CloseSomeLibs;
  331.                      CloseLib(Gadtoolsbase);
  332.                      help:=CloseUtility;
  333.                      exit;
  334.                     END;
  335.           END;
  336.          ALLOK:=true;
  337.         END;
  338.       IF ALLOK=false
  339.        THEN
  340.         BEGIN
  341.          RT:=RTReq('DiskLabel','Kann Programm nicht starten.',
  342.                    '_Argh',ReqPos_TopLeftScr);
  343.          exit;
  344.         END;
  345.  
  346.   CyTx:=CTextType('',
  347.                   'Programmieren','Source .p','Source .c','Source .asm',
  348.                   'Graphik','Public Domain','PD/FD/SW/GW','Text / DTP',
  349.                   'Utilities','Tools','Anwendung','Kalkulation',
  350.                   'Datenbank','Daten','Demo','Sound',
  351.                   'Module','Disk Mag','Game','Adventure',
  352.                   'Rollenspiel','Action','Unterhaltung','Simulation',
  353.                   'Sportspiel','Amiga','IBM-PC','Apple-Mac');
  354.  
  355.   FOR i:=0 TO 28 DO
  356.    BEGIN
  357.     IF i<10 THEN CyLa[i]:='0'+Intstr(i)
  358.             ELSE CyLa[i]:=Intstr(i);
  359.     cfeld[i]:=^CyLa[i];
  360.    END;
  361.  
  362.   cfeld[29]:=NIL;
  363.  
  364.   STx[1]:=CyTx[0];
  365.  
  366.   Tags:=GTagType(TagType(TagItem(GT_Underscore,ord('_')),
  367.                          TagItem(GTST_MaxChars,33),            {Kante}
  368.                          TagItem(GA_TabCycle,ord(true)),       {0}
  369.                          TagItem(GTST_String,long(^STx[0])),
  370.                          TagItem(Tag_Done,0)),
  371.                  TagType(TagItem(GT_Underscore,ord('_')),
  372.                          TagItem(GTST_MaxChars,13),            {Verwendung}
  373.                          TagItem(GA_TabCycle,ord(true)),       {1}
  374.                          TagItem(GTST_String,long(^STx[1])),
  375.                          TagItem(Tag_Done,0)),
  376.                  TagType(TagItem(GT_Underscore,ord('_')),
  377.                          TagItem(GTST_MaxChars,25),            {Zeile 1}
  378.                          TagItem(GA_TabCycle,ord(true)),       {2}
  379.                          TagItem(GTST_String,long(^STx[2])),
  380.                          TagItem(Tag_Done,0)),
  381.                  TagType(TagItem(GT_Underscore,ord('_')),
  382.                          TagItem(GTST_MaxChars,25),            {Zeile 2}
  383.                          TagItem(GA_TabCycle,ord(true)),       {3}
  384.                          TagItem(GTST_String,long(^STx[3])),
  385.                          TagItem(Tag_Done,0)),
  386.                  TagType(TagItem(GT_Underscore,ord('_')),
  387.                          TagItem(GTST_MaxChars,25),            {Zeile 3}
  388.                          TagItem(GA_TabCycle,ord(true)),       {4}
  389.                          TagItem(GTST_String,long(^STx[4])),
  390.                          TagItem(Tag_Done,0)),
  391.                  TagType(TagItem(GT_Underscore,ord('_')),
  392.                          TagItem(GTST_MaxChars,25),            {Zeile 4}
  393.                          TagItem(GA_TabCycle,ord(true)),       {5}
  394.                          TagItem(GTST_String,long(^STx[5])),
  395.                          TagItem(Tag_Done,0)),
  396.                  TagType(TagItem(GT_Underscore,ord('_')),
  397.                          TagItem(GTST_MaxChars,25),            {Zeile 5}
  398.                          TagItem(GA_TabCycle,ord(true)),       {6}
  399.                          TagItem(GTST_String,long(^STx[6])),
  400.                          TagItem(Tag_Done,0)),
  401.                  TagType(TagItem(GT_Underscore,ord('_')),
  402.                          TagItem(GTST_MaxChars,25),            {Zeile 6}
  403.                          TagItem(GA_TabCycle,ord(true)),       {7}
  404.                          TagItem(GTST_String,long(^STx[7])),
  405.                          TagItem(Tag_Done,0)),
  406.                  TagType(TagItem(GT_Underscore,ord('_')),
  407.                          TagItem(GTST_MaxChars,10),            {Date}
  408.                          TagItem(GA_TabCycle,ord(true)),       {8}
  409.                          TagItem(GTST_String,long(^STx[8])),
  410.                          TagItem(Tag_Done,0)),
  411.                  TagType(TagItem(GT_Underscore,ord('_')),
  412.                          TagItem(GTST_MaxChars,4),             {Disk_Nr}
  413.                          TagItem(GA_TabCycle,ord(true)),       {9}
  414.                          TagItem(GTST_String,long(^STx[9])),
  415.                          TagItem(Tag_Done,0)),
  416.                  TagType(TagItem(GTCY_Active,0),
  417.                          TagItem(GTCY_LABELS,long(^cfeld)),
  418.                          TagItem(GT_Underscore,ord('_')),
  419.                          TagItem(Tag_Done,0),                  {@ 10}
  420.                          TagItem(Tag_Done,0)),                {wegen Array}
  421.                  TagType(TagItem(GT_Underscore,ord('_')),
  422.                          TagItem(GTCB_Checked,ord(true)),
  423.                          TagItem(tag_done,0),                 {Checkboxes}
  424.                          TagItem(GTCB_Checked,ord(false)),    { 11 }
  425.                          TagItem(tag_done,0)));
  426.  
  427.   GTags[0]:=TagItem(GT_Underscore,ord('_'));
  428.   GTags[1].ti_Tag:=Tag_Done;
  429.  
  430.   STx[1]:=CyTx[0];
  431.  
  432.   ng:=NewGadget(14*Wbr,ScrTextFont+ysize,28*Wbr,ysize+6,'_Kante:',
  433.                 ^txattr,0,PLACETEXT_LEFT,vi,nil);
  434.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[0]);
  435.   g[0]:=pgad;
  436.  
  437.   ng.ng_TopEdge:=ScrTextFont+3*ysize;
  438.   ng.ng_GadgetID:=1;
  439.   ng.ng_GadgetText:='_Verwendung:';
  440.   ng.ng_width:=16*wbr;
  441.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[1]);
  442.   g[1]:=pgad;
  443.  
  444.   ng.ng_TopEdge:=ScrTextFont+5*ysize;
  445.   ng.ng_GadgetID:=2;
  446.   ng.ng_Width:=28*wbr;
  447.   ng.ng_GadgetText:='Zeile _1:';
  448.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[2]);
  449.   g[2]:=pgad;
  450.  
  451.   ng.ng_TopEdge:=ScrTextFont+7*ysize;
  452.   ng.ng_GadgetID:=3;
  453.   ng.ng_GadgetText:='Zeile _2:';
  454.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[3]);
  455.   g[3]:=pgad;
  456.  
  457.   ng.ng_TopEdge:=ScrTextFont+9*ysize;
  458.   ng.ng_GadgetID:=4;
  459.   ng.ng_GadgetText:='Zeile _3:';
  460.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[4]);
  461.   g[4]:=pgad;
  462.  
  463.   ng.ng_TopEdge:=ScrTextFont+11*ysize;
  464.   ng.ng_GadgetID:=5;
  465.   ng.ng_GadgetText:='Zeile _4:';
  466.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[5]);
  467.   g[5]:=pgad;
  468.  
  469.   ng.ng_TopEdge:=ScrTextFont+13*ysize;
  470.   ng.ng_GadgetID:=6;
  471.   ng.ng_GadgetText:='Zeile _5:';
  472.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[6]);
  473.   g[6]:=pgad;
  474.  
  475.   ng.ng_TopEdge:=ScrTextFont+15*ysize;
  476.   ng.ng_GadgetID:=7;
  477.   ng.ng_GadgetText:='Zeile _6:';
  478.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[7]);
  479.   g[7]:=pgad;
  480.  
  481.   ng.ng_TopEdge:=ScrTextFont+17*ysize;
  482.   ng.ng_GadgetID:=8;
  483.   ng.ng_Width:=13*wbr;
  484.   ng.ng_GadgetText:='D_atum:';
  485.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[8]);
  486.   g[8]:=pgad;
  487.  
  488.   ng.ng_TopEdge:=ScrTextFont+19*ysize;
  489.   ng.ng_GadgetID:=9;
  490.   ng.ng_Width:=7*wbr;
  491.   ng.ng_GadgetText:='Di_sk-Nr:';
  492.   pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[9]);
  493.   g[9]:=pgad;
  494.  
  495.   ng:=NewGadget(14*WBr,ScrTextFont+22*ysize,8*Wbr,ysize+6,'_Info',
  496.                 ^txattr,10,PLACETEXT_IN,vi,nil);
  497.   pgad:=CreateGadgetA(BUTTON_KIND,pgad,^ng,^GTags[0]);
  498.   g[10]:=pgad;
  499.  
  500.   ng.ng_LeftEdge:=24*Wbr;
  501.   ng.ng_GadgetID:=11;
  502.   ng.ng_GadgetText:='_Druck';
  503.   pgad:=CreateGadgetA(BUTTON_KIND,pgad,^ng,^GTags[0]);
  504.   g[11]:=pgad;
  505.  
  506.   ng.ng_LeftEdge:=34*Wbr;
  507.   ng.ng_GadgetID:=12;
  508.   ng.ng_GadgetText:='_Neu';
  509.   pgad:=CreateGadgetA(BUTTON_KIND,pgad,^ng,^GTags[0]);
  510.   g[12]:=pgad;
  511.  
  512.   ng:=NewGadget(32*Wbr,ScrTextFont+3*ysize,7*Wbr,ysize+6,'_W',
  513.                 ^txattr,13,PLACETEXT_RIGHT,vi,nil);
  514.   pgad:=CreateGadgetA(CYCLE_KIND,pgad,^ng,^Tags[10]);
  515.   g[13]:=pgad;
  516.  
  517.   ng:=NewGadget(32*Wbr,ScrTextFont+17*ysize+ROUND((ysize-5)/2),Wbr,
  518.                 ysize+6,'_T',^txattr,14,PLACETEXT_RIGHT,vi,nil);
  519.   pgad:=CreateGadgetA(CHECKBOX_KIND,pgad,^ng,^Tags[11]);
  520.   g[14]:=pgad;
  521.  
  522.   ng.ng_TopEdge:=ScrTextFont+19*ysize+ROUND((ysize-5)/2);
  523.   ng.ng_GadgetID:=15;
  524.   ng.ng_GadgetText:='_R';
  525.   pgad:=CreateGadgetA(CHECKBOX_KIND,pgad,^ng,^Tags[11]);
  526.   g[15]:=pgad;
  527.  
  528.   titel:='DiskLabel 1.03  (28.06.94)';
  529.  
  530.    NWTags[1] :=Tagitem(wa_top,0);
  531.    NWTags[2] :=Tagitem(wa_left,0);
  532.    NWTags[3] :=Tagitem(wa_width,44*Wbr);
  533.    NWTags[4] :=Tagitem(wa_height,ScrTextFont+25*ysize);
  534.    NWTags[5] :=Tagitem(wa_activate,ord(true));
  535.    NWTags[6] :=Tagitem(wa_smartrefresh,ord(true));
  536.    NWTags[7] :=Tagitem(wa_rmbtrap,ord(true));
  537.    NWTags[8] :=Tagitem(wa_title,long(^titel));
  538.    NWTags[9]:=Tagitem(wa_Flags,WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+
  539.                                 WFLG_DRAGBAR);
  540.    NWTags[10]:=Tagitem(wa_idcmp,IDCMP_GADGETUP+IDCMP_RAWKEY+
  541.                                 IDCMP_CLOSEWINDOW);
  542.    NWTags[11] :=Tagitem(wa_Gadgets,long(glist));
  543.    NWTags[12].ti_tag:=tag_done;
  544.  
  545.    Win:=openwindowtaglist(nil,^NWTags[1]);
  546.    IF Win<>NIL THEN
  547.     BEGIN
  548.      RP:=Win^.RPort;
  549.      ourfont:=setfont(RP,font);
  550.      ex:=false;
  551.      gedr1:=false;
  552.      gedr2:=false;
  553.      REPEAT
  554.       Msg:=Wait_Port(Win^.UserPort);
  555.       Msg:=GT_GetIMsg(Win^.UserPort);
  556.       Code:=Msg^.Code;
  557.       IF Msg<>NIL THEN
  558.        BEGIN
  559.         GT_ReplyIMsg(Msg);
  560.         CASE Msg^.Class OF
  561.  
  562.         IDCMP_CLOSEWINDOW: Ende;
  563.  
  564.         IDCMP_GADGETUP:
  565.          BEGIN
  566.           Akt:=Msg^.IAddress;
  567.           CASE AKT^.GADGETID OF
  568.            0..8: strakt:=ACTIVATEGADGET(g[AKT^.GADGETID+1],Win,NIL);
  569.              10: InfoLine;
  570.              11: Druck;
  571.              12: Neu;
  572.              13: Cycle(2);
  573.              14: IF chNr1=1 THEN DEC(chNR1) ELSE INC(chNr1); { Checkbox D }
  574.              15: IF chNr2=1 THEN DEC(chNR2) ELSE INC(chNr2); { Checkbox N }
  575.           ELSE;END;
  576.          END;
  577.         IDCMP_RAWKEY:
  578.          BEGIN
  579.           CASE (Code AND $7f) OF
  580.            $60: IF (Code AND $80)=0
  581.                  THEN gedr1:=true ELSE gedr1:=false;
  582.            $61: IF (Code AND $80)=0
  583.                  THEN gedr2:=true ELSE gedr2:=false;
  584.           ELSE
  585.            CASE Msg^.code OF
  586.                $27: strakt:=ACTIVATEGADGET(g[0],Win,NIL);    {K Kante}
  587.                $34: strakt:=ACTIVATEGADGET(g[1],Win,NIL);    {V Verw.}
  588.                $01: strakt:=ACTIVATEGADGET(g[2],Win,NIL);    {1 Z1}
  589.                $02: strakt:=ACTIVATEGADGET(g[3],Win,NIL);    {2 Z2}
  590.                $03: strakt:=ACTIVATEGADGET(g[4],Win,NIL);    {3 Z3}
  591.                $04: strakt:=ACTIVATEGADGET(g[5],Win,NIL);    {4 Z4}
  592.                $05: strakt:=ACTIVATEGADGET(g[6],Win,NIL);    {5 Z5}
  593.                $06: strakt:=ACTIVATEGADGET(g[7],Win,NIL);    {6 Z6}
  594.                $20: strakt:=ACTIVATEGADGET(g[8],Win,NIL);    {A Datum}
  595.                $21: strakt:=ACTIVATEGADGET(g[9],Win,NIL);    {S Disk-Nr}
  596.                $11: Cycle(1);                                    { W.}
  597.                $14: BEGIN                                        { T }
  598.                      IF chNr1=1 THEN DEC(chNR1) ELSE INC(chNr1);
  599.                      IF chNr1=1
  600.                       THEN GT_SetGadgetAttrsA(g[14],Win,NIL,^Tags[11,1])
  601.                       ELSE GT_SetGadgetAttrsA(g[14],Win,NIL,^Tags[11,3]);
  602.                     END;
  603.                $13: BEGIN                                        { R }
  604.                      IF chNr2=1 THEN DEC(chNR2) ELSE INC(chNr2);
  605.                      IF chNr2=1
  606.                       THEN GT_SetGadgetAttrsA(g[15],Win,NIL,^Tags[11,1])
  607.                       ELSE GT_SetGadgetAttrsA(g[15],Win,NIL,^Tags[11,3]);
  608.                     END;
  609.                $17: InfoLine;                                    { I }
  610.                $36: Neu;                                         { N }
  611.                $22: Druck;                                       { D }
  612.  
  613.  
  614.                $10, {Q/E/ESC}
  615.                $12,
  616.                $45: Ende;
  617.             ELSE;END;
  618.            END; {of äußeres CASE OF}
  619.          END;
  620.         ELSE;END;
  621.        END;
  622.       UNTIL ex;
  623.  
  624.      CloseWindow(Win);
  625.     END
  626.    ELSE RT:=RTReq('DiskLabel','Kann Oberfläche nicht darstellen.',
  627.                       '_Argh',ReqPos_TopLeftScr);
  628.      FreeGadgets(glist);
  629.      FreeVisualInfo(vi);
  630.      CloseSomeLibs;
  631.      CloseLib(Gadtoolsbase);
  632.      help:=CloseUtility;
  633.   END;
  634.  END;
  635. END;
  636.  
  637. {********************************** MAIN *********************************}
  638.  
  639. BEGIN
  640.  cycleNr:=0;
  641.  chNr1:=1;chNr2:=1;
  642.  FOR i:=0 TO 9 DO STx[i]:='';
  643.  help:=getbattclockL;
  644.  IF battclockdate<>'' THEN STx[8]:=battclockdate;
  645.  InitWin;
  646. END.
  647.  
  648.